home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / boost4.zip / BOSHARE.PAS next >
Pascal/Delphi Source File  |  1988-10-23  |  11KB  |  378 lines
  1.             { - - - - - - - - - - - - - - - - - - - - - - - - - - }
  2.             {                   B O O S T E R S                   }
  3.             {               Assembly Language Power               }
  4.             {                        for                          }
  5.             {            Turbo Pascal 4.0 Programmers             }
  6.             {               Shareware Version 4.0                 }
  7.             {                                                     }
  8.             {         Copyright (C) 1985, 1986, 1987, 1988        }
  9.             {              George F. Smith & Company              }
  10.             {                 609 Candlewick Lane                 }
  11.             {                  Lilburn, GA 30247                  }
  12.             {                   (404) 923-6879                    }
  13.             {                 All Rights Reserved                 }
  14.             {                                                     }
  15.             {        If you like Boosters, please register        }
  16.             {        for $18.90.  Or, if you prefer, you may      }
  17.             {        order the complete library from the above    }
  18.             {        address (check, VISA/MC).                    }
  19.             {            * with documentation on disk ... $25     }
  20.             {            * with printed manual .......... $35     }
  21.             {            * with printed manual &                  }
  22.             {              assembler source ............. $50     }
  23.             { - - - - - - - - - - - - - - - - - - - - - - - - - - }
  24. unit BOSHARE;
  25.  
  26. INTERFACE
  27.  
  28. uses Dos, Crt;
  29.  
  30. Type
  31.    HeapBuf   = ^AnyBuf;
  32.    AnyBuf    = record
  33.                   Screen : array[1..4000] of byte;
  34.                end;
  35.  
  36. Const
  37.    h = 'H';           { horizontal screen writes }
  38.    v = 'V';           { vertical screen writes }
  39.  
  40. Var
  41.    HeapTop : ^integer;
  42.    HPage   : HeapBuf;
  43.    Regs    : registers;                       { Defined in Dos unit     }
  44.    VideoStatus : byte absolute $0040:$0049;   { =  7 monochrome adapter }
  45.                                               { <> 7 graphics adapter   }
  46.    VideoSeg : word;                           { = $B000 for monochrome  }
  47.                                               { = $B800 for graphics    }
  48.    SnowRemoval : Boolean;                     { = TRUE, routines will remove }
  49.                                               {         snow (intended for   }
  50.                                               {         old CGAs).           }
  51.                                               { = FALSE, routines will access}
  52.                                               {          video w/o checking  }
  53.                                               {          for snow.           }
  54.  
  55.   { Time and date variables for Fstamp }
  56.    Filehh, Filemin, Filesec,
  57.    Fileyy, Filemm,  Filedd,
  58.  
  59.   { Variables for Timer and Wait }
  60.    TimeElapsed,
  61.    SaveElapsed,
  62.    DTASeg, DTAOfs : Integer;
  63.  
  64.    FileSpec,
  65.    FileName,
  66.    CurPath,
  67.    Path           : String;
  68.  
  69.    SubDirFlag,
  70.    StartElapsed   : Boolean;
  71.  
  72. procedure Box      (x1, y1, x2, y2, style, att : integer );
  73. procedure Boxheap  ( Hpage : heapbuf; x1, y1, x2, y2, style, att : integer );
  74.  
  75. procedure Cblkheap ( Hpage : heapbuf; x1,y1,x2,y2,x3,y3 : integer);
  76. function  Center   ( S : String; Width : integer; Pad : char ) : String;
  77. procedure ChgAtt   ( x1, y1, x2, y2 : integer; FromAtt, ToAtt : byte );
  78. function  Cntch    ( S : String; C : char ) : integer;
  79. function  Copies   ( C : char; N : integer ) : String;
  80. procedure CopyBlk  ( x1,y1,x2,y2,x3,y3 : integer );
  81. procedure CopyHeap ( FromPage, ToPage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
  82. function  CopyStr  ( S : String; n : integer ) : String;
  83. procedure CtrScr   ( nsew : char; s : String; len, x, y : integer;
  84.                      att : byte );
  85.  
  86. procedure DiffOne  ( EW : char );
  87. procedure Disk2Mem ( FileDesc : String; Num : integer;
  88.                      Hpage : HeapBuf; var Ecode : integer );
  89. function  Dows     ( month, day, year : integer ) : String;
  90. function  Dow      ( month, day, year : integer ) : integer;
  91. function  DriveCnt : integer;
  92.  
  93. procedure Fil2Heap ( FileDesc : String; FromScreen, ToScreen : integer;
  94.                      Hpage : HeapBuf; var Ecode : integer );
  95. procedure FillHeap ( Hpage : Heapbuf; x1,y1,x2,y2 : integer;
  96.                      ch : char; att : byte );
  97. procedure FindStr  ( x,y : integer; s : String; offset : integer;
  98.                      var Ecode : integer );
  99. procedure FstrHeap ( Hpage : HeapBuf; s : String; var x, y, ecode : integer );
  100.  
  101. function  GchaHeap ( Hpage : HeapBuf; x, y : integer ) : integer;
  102. function  GetAtt   ( x, y : integer ) : byte;
  103. function  GetChar  ( x, y : integer ) : Char;
  104. procedure GetHeap  ( Hpage : HeapBuf; hv : char; S : String;
  105.                      x, y, len : integer );
  106. procedure GetStr   ( hv : char; S : String; x, y : integer; len : byte );
  107.  
  108. procedure Heap2Scr ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer);
  109. procedure HeapAtt  ( Hpage : HeapBuf; x1,y1,x2,y2 : integer; att : byte );
  110. function  Hex      ( DecimalValue : word ) : String;
  111.  
  112. procedure Input    ( x, y : integer; Filter : String; var Data : String;
  113.                      var LastCh : char; att : byte );
  114.  
  115. procedure Input2   ( x, y : integer; Filter : String; var Data : String;
  116.                      var LastCh : char; att : byte );
  117.  
  118. function  LastPos  ( Needle, HayStack : String; Start : integer ) : integer;
  119. function  Left     ( S : String; Width : Integer; Pad : Char ) : String;
  120. function  Lower    ( S : String ) : String;
  121.  
  122. procedure MblkHeap ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
  123. procedure MoveBg   ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer);
  124. procedure MoveBlk  ( x1,y1,x2,y2,x3,y3 : integer );
  125. procedure MoveBlkr ( x1,y1,x2,y2,x3,y3 : integer; att : byte );
  126.  
  127.  
  128. function OverStr   ( New, Target : String; N, Len : Integer;
  129.                      Pad : Char ) : String;
  130.  
  131. procedure PchaHeap ( Hpage : HeapBuf; AttCh, x, y : integer );
  132. procedure Pdq      ( nsew : char; S : String; x, y : integer; att : byte );
  133. function  PosR     ( Needle, HayStack : String; Start : integer ) : Integer;
  134. procedure PutHeap  ( Hpage : HeapBuf; hv : char; S : String; x,y : integer;
  135.                      att : byte );
  136. procedure PutStr   ( hv : char; S : String; x, y : integer; att : byte );
  137.  
  138. procedure RemBlk  ( x1, y1, x2, y2 : integer );
  139. procedure RemBlkR ( x1, y1, x2, y2 : integer; att : byte );
  140. procedure RestoreScreen ( Hpage : HeapBuf );
  141. function  Right   ( S : String; Width : Integer; Pad : Char ) : String;
  142. function  Rword   ( StrA : String; N : integer; StrB : String ) : String;
  143.  
  144. procedure SaveScreen ( Hpage : HeapBuf );
  145. procedure Scr2Disk   ( FileDesc : String; ScreenNumber : integer;
  146.                        var Ecode : integer );
  147. procedure Scr2Heap   ( Hpage : HeapBuf; x1,y1,x2,y2,x3,y3 : integer );
  148. procedure SetAtt     ( x1, y1, x2, y2 : integer; att : byte );
  149. function  Space      ( S : String; N : integer; Pad : Char ) : String;
  150. function  Strip      ( S : String; Pad : Char ) : String;
  151. function  Stripr     ( S : String; option , pad : char ) : String;
  152. function  SubWord    ( S : String; N, NumWords : integer ) : String;
  153.  
  154. function  translate  ( S, InTable, OutTable : String; Pad : Char ) : String;
  155.  
  156. function  Upper   ( S : String ) : String;
  157.  
  158. function  Verify  ( S, Reference : String;  Start : Integer ) : Integer;
  159.  
  160. function  WordInd ( S : String; N : Integer ) : Integer;
  161. function  Wordn   ( S : String; n : integer ) : String;
  162. function  WordPos ( Needle, Haystack : String; Start,
  163.                     IgnoreSpaces : Integer ) : Integer;
  164. function  Words   ( S : String ) : integer;
  165.  
  166.  
  167.  
  168. IMPLEMENTATION
  169.  
  170. { - - - - - - - - - - - - - - - - - - - -
  171.   E X T E R N A L S
  172.   - - - - - - - - - - - - - - - - - - - - }
  173.  
  174. {$L BOX}
  175. procedure Box; external;
  176.  
  177. {$L BOXHEAP}
  178. procedure Boxheap; external;
  179.  
  180. {$L CBLKHEAP}
  181. procedure Cblkheap; external;
  182.  
  183. {$L CENTER}
  184. function Center; external;
  185.  
  186. {$L CHGATT}
  187. procedure ChgAtt; external;
  188.  
  189. {$L CNTCH}
  190. function Cntch; external;
  191.  
  192. {$L COPIES}
  193. function Copies; external;
  194.  
  195. {$L COPYBLK}
  196. procedure Copyblk; external;
  197.  
  198. {$L COPYHEAP}
  199. procedure CopyHeap; external;
  200.  
  201. {$L COPYSTR}
  202. function Copystr; external;
  203.  
  204. {$L CTRSCR}
  205. procedure Ctrscr; external;
  206.  
  207. {$L DIFFONE}
  208. procedure Diffone; external;
  209.  
  210. {$L DISK2MEM}
  211. procedure Disk2Mem; external;
  212.  
  213. {$L DOW}
  214. function Dow; external;
  215.  
  216. {$L DOWS}
  217. function Dows; external;
  218.  
  219. {$L DRIVECNT}
  220. function Drivecnt; external;
  221.  
  222. {$L FIL2HEAP}
  223. procedure Fil2Heap; external;
  224.  
  225. {$L FILLHEAP}
  226. procedure Fillheap; external;
  227.  
  228. {$L FINDSTR}
  229. procedure Findstr; external;
  230.  
  231. {$L FSTRHEAP}
  232. procedure Fstrheap; external;
  233.  
  234. {$L GCHAHEAP}
  235. function GchaHeap; external;
  236.  
  237. {$L GETATT}
  238. function Getatt; external;
  239.  
  240. {$L GETCHAR}
  241. function Getchar; external;
  242.  
  243. {$L GETHEAP}
  244. procedure Getheap; external;
  245.  
  246. {$L GETSTR}
  247. procedure Getstr; external;
  248.  
  249. {$L HEAP2SCR}
  250. procedure Heap2scr; external;
  251.  
  252. {$L HEAPATT}
  253. procedure Heapatt; external;
  254.  
  255. {$L HEX}
  256. function Hex; external;
  257.  
  258. {$L INPUT}
  259. procedure Input; external;
  260.  
  261. {$L INPUT2}
  262. procedure Input2; external;
  263.  
  264. {$L LASTPOS}
  265. function Lastpos; external;
  266.  
  267. {$L LEFT}
  268. function Left; external;
  269.  
  270. {$L LOWER}
  271. function Lower; external;
  272.  
  273. {$L MBLKHEAP}
  274. procedure MblkHeap; external;
  275.  
  276. {$L MOVEBG}
  277. procedure Movebg; external;
  278.  
  279. {$L MOVEBLK}
  280. procedure Moveblk; external;
  281.  
  282. {$L MOVEBLKR}
  283. procedure Moveblkr; external;
  284.  
  285. {$L OVERSTR}
  286. function OverStr; external;
  287.  
  288. {$L PCHAHEAP}
  289. procedure PchaHeap; external;
  290.  
  291. {$L PDQ}
  292. procedure Pdq; external;
  293.  
  294. {$L POSR}
  295. function PosR; external;
  296.  
  297. {$L PUTHEAP}
  298. procedure PutHeap; external;
  299.  
  300. {$L PUTSTR}
  301. procedure Putstr; external;
  302.  
  303. {$L REMBLK}
  304. procedure RemBlk; external;
  305.  
  306. {$L REMBLKR}
  307. procedure RemBlkR; external;
  308.  
  309. {$L RESTORES}
  310. procedure RestoreScreen; external;
  311.  
  312. {$L RIGHT}
  313. function Right; external;
  314.  
  315. {$L RWORD}
  316. function Rword; external;
  317.  
  318. {$L SAVES}
  319. procedure SaveScreen; external;
  320.  
  321. {$L SCR2DISK}
  322. procedure Scr2Disk; external;
  323.  
  324. {$L SCR2HEAP}
  325. procedure Scr2Heap; external;
  326.  
  327. {$L SETATT}
  328. procedure SetAtt; external;
  329.  
  330. {$L SPACE}
  331. function Space; external;
  332.  
  333. {$L STRIP}
  334. function Strip; external;
  335.  
  336. {$L STRIPR}
  337. function Stripr; external;
  338.  
  339. {$L SUBWORD}
  340. function SubWord; external;
  341.  
  342. {$L TRANSLATE}
  343. function Translate; external;
  344.  
  345. {$L UPPER}
  346. function Upper; external;
  347.  
  348. {$L VERIFY}
  349. function Verify; external;
  350.  
  351. {$L WORDIND}
  352. function WordInd; external;
  353.  
  354. {$L WORDN}
  355. function Wordn; external;
  356.  
  357. {$L WORDPOS}
  358. function WordPos; external;
  359.  
  360. {$L WORDS}
  361. function Words; external;
  362.  
  363.  
  364.  
  365. BEGIN  { initialization }
  366.  
  367.    { Set SnowRemoval flag and video memory segment address }
  368.  
  369.    SnowRemoval := False;
  370.    if LastMode = 7 then
  371.       VideoSeg := $B000   { Monochrome }
  372.    else
  373.       VideoSeg := $B800;  { Graphics  }
  374.  
  375.    { StartElapsed is used by Timer.pas }
  376.    StartElapsed := False;
  377.  
  378. END.   { Boosters 4.0 Shareware unit }